perm filename III[CAR,BGB] blob
sn#016006 filedate 1972-12-20 generic text, type T, neo UTF8
00100 ;TITLE III
00200 ; -- DISPLAY SUBROUTINES -- NOVEMBER 1972.
00300
00400 ;DISPLAY UUO CODES.
00500 OPDEF DPYPOS [XWD 702100,0]
00600 OPDEF DPYSIZ [XWD 702140,0]
00700 OPDEF DPYCLR [XWD 701000,0]
00800 OPDEF UPG [XWD 703000,0]
00900 OPDEF GETLIN [TTYUUO 6,]
01000
01100 A←1↔B←2↔C←3
01200
01300 RV←←6
01400 AVCO←←106
01500 VIS←←0
01600 EP←←20
01700 INV←←40
01800 SVS←100
01900 SV←2
02000 DPYBUF: DPYBU.
02100 =2048↔1↔XWD 1,=2048
02200 DPYBU.: BLOCK 4000
02300
02400 ;SOURCE WINDOW.
02500 SX: 0
02600 SY: 0
02700 SOX: 0
02800 SOY: 0
02900
03000 ;OBJECT WINDOW.
03100 OX: 0
03200 OY: 0
03300 MAG: 3.4
03400 DEL: 32.0
03500
03600 ;PSEUDO BEAM POSITION.
03700 XXX: 0
03800 YYY: 0
03900
04000
04100 DECLARE{XL,XH,YL,YH}
04200 IGNORE: 0
04300 DPYPTR: 0
04400 BUFEND: 0
04500 BUFHD: 0
04600 0
00100 DPYBIG: LAC 1,ARG1
00200 LACI 3,INV+RV ;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
00300 DPB 1,[POINT 3,3,27]
00400 PUSH P,(P) ;COPY PC.
00500 GO LV2
00600
00700 DPYBRT: LAC 1,ARG1
00800 LACI 3,INV+RV
00900 DPB 1,[POINT 3,3,24]
01000 PUSH P,(P) ;COPY PC.
01100 GO LV2
01200
01300 AIVECT: SKIPA C,[INV+AVCO]
01400 AVECT: LACI C,VIS+AVCO
01500 LV: LAC 1,ARG2↔LAC 2,ARG1
01600 SKIPGE IGNORE↔POP2J
01700 LVC: DPB A,[POINT 11,C,10]
01800 DPB B,[POINT 11,C,21]
01900 LV2: AOS A,DPYPTR
02000 DAC C,(A)
02100 LV3: LIPI A,<(<POINT 7,0,35>)>
02200 DAC A,DPYPTR
02300 LACI A,(A)
02400 CAML A,BUFEND
02500 SETOM IGNORE
02600 POP2J
00100 DTYO: LAC 1,ARG1
00200 IDPB A,DPYPTR
00300 CDR A,DPYPTR
00400 CAML A,BUFEND
00500 SETOM IGNORE
00600 POP1J
00700
00800 DPYCLR: SKIPL DPYFLG#
00900 DPYCLR
01000 SETZM BUFHD
01100 POPJ P,
01200
01300 DPYOUT:
01400 SKIPN 1,BUFHD↔GO .+6
01500 LAC 2,DPYPTR↔DAC 2,-2(1)
01600 LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
01700 CDR B,DPYPTR
01800 SUB B,BUFHD
01900 ADDI B,1
02000 DAC B,BUFHD+1
02100 LAC 1,ARG1
02200 DPB A,[POINT 4,SH1,12]
02300 OR A,DPYFLG
02400 SKIPL A
02500 SH1: UPG BUFHD
02600 POP1J
02700
02800 DPYSET: SETZM DPYFLG
02900 LAC 1,ARG1
03000 ADDI 1,2
03100 DAC 1,BUFHD
03200 CDR 2,-3(1) ;SIZE
03300 ADDI 2,-3(1)
03400 SUBI 2,1
03500 SETZM IGNORE
03600 DAC 2,BUFEND
03700 CLR2: LAC A,BUFHD
03800 LACI B,1
03900 DAC B,1(A)
04000 LACI B,2(A)
04100 LIPI B,1(A)
04200 BLT B,@BUFEND ;SET DPY BUFFER TO NULL CHARACTER WORDS
04300 PUSH P,(P) ;COPY PC.
04400 GO LV3
00100 ;CLIPER - 2D LINE SEGMENT CLIPPER - AUGUST 1972.
00200
00300
00400 SUBR(CROP)--------------------------------------------------------
00500 BEGIN CLIPIN
00600 LAC 1,OX↔LAC MAG↔FMP SX↔FSB 1,0↔DAC 1,SOX
00700 LAC 1,OY↔LAC MAG↔FMP SY↔FSB 1,0↔DAC 1,SOY
00800
00900 LAC 1,OX↔LAC MAG↔FMP[155.0]↔FSB 1,0
01000 CAMG 1,[-510.0]↔LAC 1,[-510.0]↔DAC 1,XL
01100 LAC 1,OX↔LAC MAG↔FMP[155.0]↔FAD 1,0
01200 CAML 1,[ 510.0]↔LAC 1,[510.0]↔DAC 1,XH
01300
01400 LAC 1,OY↔LAC MAG↔FMP[115.0]↔FSB 1,0
01500 CAMG 1,[-470.0]↔LAC 1,[-470.0]↔DAC 1,YL
01600 LAC 1,OY↔LAC MAG↔FMP[115.0]↔FAD 1,0
01700 CAML 1,[ 470.0]↔LAC 1,[470.0]↔DAC 1,YH
01800
01900 POP0J
02000 BEND;20/12/72-----------------------------------------------------
00100 SUBR(AI)----------------------------------------------------------
00200 BEGIN AI
00300 LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX
00400 LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY
00500 SETZM AIVFLG
00600 POP2J
00700 BEND;20/12/72-----------------------------------------------------
00800
00900 AIVFLG:0
01000 SUBR(AV)----------------------------------------------------------
01100 BEGIN AV
01200 LAC XXX↔DAC X1
01300 LAC YYY↔DAC Y1
01400 LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX↔DAC X2
01500 LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY↔DAC Y2
01600 CALL(CLIP,X1,Y1,X2,Y2)
01700 JUMPE 1,[SETZM AIVFLG↔POP2J]
01800 CAIN 1,1↔GO[
01900 SKIPN AIVFLG↔GO[
02000 SETOM AIVFLG↔GO L1+1]↔GO L2]
02100 L1: SETZM AIVFLG
02200 FIXX 6,↔FIXX 7,↔CALL(AIVECT,6,7)
02300 L2: FIXX 8,↔FIXX 9,↔CALL(AVECT,8,9)
02400 POP2J
02500 DECLARE{X1,Y1,X2,Y2}
02600 BEND;20/12/72-----------------------------------------------------
00100 DECLARE{AAA,BBB,CCC,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
00200 SUBR(CLIP)--------------------------------------------------------
00300 ; FLG ← CLIP(X1,Y1,X2,Y2) RETURN TRUE WHEN PORTION IS VISIBLE.
00400 BEGIN CLIP
00500 ACCUMULATORS{X1,Y1,X2,Y2,PDL}
00600 PTR←13
00700
00800 ;PICK 'EM UP;
00900 LAC X1,ARG4↔LAC Y1,ARG3
01000 LAC X2,ARG2↔LAC Y2,ARG1
01100 LACI PTR,PDL-1
01200
01300 ;SET NSEW BITS.
01400 SETZB 1
01500 CAMLE Y1,YH↔TRO 8↔CAMLE Y2,YH↔TRO 1,8; NORTH.
01600 CAMGE Y1,YL↔TRO 4↔CAMGE Y2,YL↔TRO 1,4; SOUTH.
01700 CAMLE X1,XH↔TRO 2↔CAMLE X2,XH↔TRO 1,2; EAST.
01800 CAMGE X1,XL↔TRO 1↔CAMGE X2,XL↔TRO 1,1; WEST.
01900
02000 ;EASY OUTSIDER EDGE.
02100 TRNE 0,(1)↔GO [OUTSIDE: SETZ 1,↔POP4J]
02200
02300 ;EASY INSIDER VERTICES.
02400 JUMPE 0,[PUSH PTR,X1↔PUSH PTR,Y1↔GO .+1]
02500 JUMPE 1,[PUSH PTR,X2↔PUSH PTR,Y2↔GO .+1]
02600 DEFINE DONE{CAMN PTR,[XWD 4,PDL+3]↔GO L}
02700 CAMN PTR,[XWD 4,PDL+3]↔GO[LACI 1,1↔GO L+1]
02800
02900 ;COMPUTE EDGE COEFFICIENTS.
03000 LAC Y1↔FSBR Y2↔DAC AAA
03100 LAC X2↔FSBR X1↔DAC BBB
03200 LAC X2↔FMPR Y1↔MOVNM CCC
03300 LAC X1↔FMPR Y2↔FADRM CCC
03400
03500 ;PARTIAL PRODUCTS.
03600 LAC AAA↔FMPR XH↔DAC AXH
03700 LAC AAA↔FMPR XL↔DAC AXL
03800 LAC BBB↔FMPR YH↔DAC BYH
03900 LAC BBB↔FMPR YL↔DAC BYL
04000
04100 ;CORNER Q'S.
04200 SETOM FLGO↔SETZM FLGZ
04300 LAC AXH↔FADR BYH↔FADR CCC↔DAC QNE↔ANDM FLGO↔IORM FLGZ
04400 LAC AXL↔FADR BYH↔FADR CCC↔DAC QNW↔ANDM FLGO↔IORM FLGZ
04500 LAC AXL↔FADR BYL↔FADR CCC↔DAC QSW↔ANDM FLGO↔IORM FLGZ
04600 LAC AXH↔FADR BYL↔FADR CCC↔DAC QSE↔ANDM FLGO↔IORM FLGZ
04700
04800 ;HARD OUTSIDER CASES.
04900 SKIPGE FLGO↔GO OUTSIDE
05000 SKIPL FLGZ↔GO OUTSIDE
00100 ;XY-CLIPPER continued.
00200 ;NORTH BORDER CROSSING.
00300 LAC QNE↔XOR QNW↔SKIPL↔GO L2
00400 LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
00500 LAC BYH↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
00600 LAC YH↔PUSH PTR,
00700 DONE
00800
00900 ;SOUTH BORDER CROSSING.
01000 L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
01100 LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
01200 LAC BYL↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
01300 LAC YL↔PUSH PTR,
01400 DONE
01500
01600 ;EAST BORDER CROSSING.
01700 L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
01800 LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
01900 LAC XH↔PUSH PTR,
02000 LAC AXH↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
02100 DONE
02200
02300 ;WEST BORDER CROSSING.
02400 L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
02500 LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
02600 LAC XL↔PUSH PTR,
02700 LAC AXL↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
02800 DONE
02900
03000 ;STRANGE EXIT - NSEW BIT MARKING & EDGE COEF ARE INCONSISTENT.
03100 L5: OUTSTR[ASCIZ/2D CLIPPER FALL THRU !
03200 /]↔ GO OUTSIDER
03300
03400 ;VISIBLE PORTION EXIT.
03500 L: SETO 1,
03600 POP4J
03700 LIT
03800 BEND;20/12/72-----------------------------------------------------
00100 SUBR(DPYIMG)------------------------------------------------------
00200 BEGIN DPYIMG; - DISPLAY 1ST IMAGE OF THE FILM - BGB - 4 DEC 1972.
00300 CALL(DPYSET,DPYBUF)
00400 CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
00500 CALL(AIVECT,[=160],[=502])
00600 CALL(DTYO,["B"])↔CALL(DTYO,["L"])↔CALL(DTYO,["K"])
00700 CALL(DTYO,["C"])↔CALL(DTYO,["N"])↔CALL(DTYO,["T"])
00800 CALL(AIVECT,[=170],[=477])
00900 LAC 1,@BLKCNT↔CALL(DECDPY)
01000 CALL(DPYOUT,[10])
01100
01200 CALL(DPYBLK)
01300 CALL(DPYGRID)
01400
01500 ;SQUARE FRAME.
01600 CALL(DPYSET,DPYBUF)
01700 CALL(AIVECT,[-=510],[-=470])
01800 CALL(AVECT,[ =510],[-=470])
01900 CALL(AVECT,[ =510],[ =470])
02000 CALL(AVECT,[-=510],[ =470])
02100 CALL(AVECT,[-=510],[-=470])
02200
02300 ;LOOP THE LEVELS, LOOP THE POLYGONS.
02400 LAC 1,FILM
02500 MARK 1,FBIT↔HEAD 1,1↔JUMPE 1,L2 ;FIRST IMAGE.
02600 HEAD 1,1↔DAC 1,LEV0#↔DAC 1,LEV1# ;FIRST LEVEL.
02700 L0: LAC 1,LEV1↔CDR 1,(1)↔DAC 1,LEV1 ;CDR-LEVEL-RING.
02800 HEAD 1,1↔DAC 1,PGN0#↔DAC 1,PGN1# ;FIRST POLYGON.
02900 L1: LAC 1,PGN1↔CDR 1,(1)↔DAC 1,PGN1 ;CDR-POLY-RING.
03000 CALL(DPYGON,1)
03100 LAC 1,PGN1↔CAME 1,PGN0↔GO L1 ;POLY-RING-END.
03200 LAC 1,LEV1↔CAME 1,LEV0↔GO L0 ;LEVEL-RING-END.
03300 L2: CALL(DPYOUT,[0])
03400 POP0J ;EXIT.
03500
03600 BEND;4/12/72------------------------------------------------------
00100 SUBR(DPYGRID)-----------------------------------------------------
00200 BEGIN DPYGRID
00300 CALL(DPYSET,DPYBUF)
00400 LAC[50.0]↔CAML MAG↔GO L
00500 SETZ 10,↔FSB 10,MAG↔CAML 10,XL↔GO .-2↔FAD 10,MAG
00600 LAC 6,YL↔FIXX 6,↔LAC 7,YH↔FIXX 7,
00700 VLINES: LAC 5,10↔FIXX 5,
00800 CALL(AIVECT,5,6)↔CALL(AVECT,5,7)
00900 FAD 10,MAG↔CAMGE 10,XH↔GO VLINES
01000
01100 SETZ 10,↔FSB 10,MAG↔CAML 10,YL↔GO .-2↔FAD 10,MAG
01200 LAC 6,XL↔FIXX 6,↔LAC 7,XH↔FIXX 7,
01300 HLINES: LAC 5,10↔FIXX 5,
01400 CALL(AIVECT,6,5)↔CALL(AVECT,7,5)
01500 FAD 10,MAG↔CAMGE 10,YH↔GO HLINES
01600
01700 L: CALL(DPYOUT,[3])
01800 POP0J
01900
02000 BEND;14/12/72-----------------------------------------------------
00100 SUBR(ID)----------------------------------------------------------
00200 BEGIN ID;IDENT DISPLAY - BGB - 13 DEC 1972.
00300 JUMPE 10,[FOR Qε{NIL }{CALL(DTYO,["Q"])↔}POP0J]
00400 LACI 2,"U"
00500 FOR @' Eε{EPLIF}{
00600 TESTZ 10,E'BIT↔LACI 2,"E"}
00700 CALL(DTYO,2)
00800 SUB 10,FILM
00900 IDIVI 10,6
01000 DIPZ 10,10
01100 JFFO 10,.+1↔CAIL 11,3↔GO[ROT 10,3↔SUBI 11,3↔GO .-1]↔ZAP 10
01200 L: ROT 10,3↔ADDI 10,60
01300 CALL(DTYO,10)↔ZAP 10↔TLNE 10,-1↔GO L
01400 CALL(DTYO,[" "])↔POP0J
01500 BEND;13/12/72-----------------------------------------------------
01600
01700 SUBR(OD)----------------------------------------------------------
01800 BEGIN OD;OCTAL HALF WORD DISPLAY - BGB - 13 DEC 1972.
01900 LACI 7,6↔DIPZ 10,10
02000 L: ROT 10,3↔ADDI 10,60↔CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
02100 CALL(DTYO,[" "])↔POP0J
02200 BEND;13/12/72-----------------------------------------------------
02300
00100 SUBR(DECDPY)------------------------------------------------------
00200 BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
00300 L: JUMPGE 1,.+5
00400 MOVM 2,1
00500 CALL(DTYO,["-"])
00600 LAC 1,2
00700 IDIVI 1,12
00800 PUSH P,2
00900 SKIPE 1
01000 PUSHJ P,L
01100 POP P,1↔ADDI 1,60
01200 CALL(DTYO,1)
01300 POP0J
01400 BEND;17/12/72-----------------------------------------------------
00100 SUBR(DPYBLK)------------------------------------------------------
00200 BEGIN DPYBLK; DISPLAY CONTENTS OF A BLOCK - BGB - 13 DEC 1972.
00300 CALL(DPYSET,DPYBUF)
00400 SKIPN 15,QBLK↔GO L2
00500 ;CONVERT TYPE BINARY.
00600 TYPE 0,15
00700 ANDI 37
00800 CAIN 4↔LACI 3
00900 CAIN 10↔LACI 4
01000 CAIN 20↔LACI 5
01100 DAC 16
01200 ;KIND OF BLOCK.
01300 CALL(AIVECT,[=300],[-=300])
01400 GO .+1(16)
01500 GO[FOR Qε{EMPTY}{CALL(DTYO,["Q"])↔}GO L1]
01600 GO[FOR Qε{EDGEV}{CALL(DTYO,["Q"])↔}GO L1]
01700 GO[FOR Qε{POLYGON}{CALL(DTYO,["Q"])↔}GO L1]
01800 GO[FOR Qε{LEVEL}{CALL(DTYO,["Q"])↔}GO L1]
01900 GO[FOR Qε{IMAGE}{CALL(DTYO,["Q"])↔}GO L1]
02000 GO[FOR Qε{FILM}{CALL(DTYO,["Q"])↔}GO L1]
02100 L1: CALL(DTYO,["-"])↔LAC 10,15↔CALL(ID)
02200 CALL(AIVECT,[=320],[-=320])
02300 CAR 10,0(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔ID↔ID↔ID↔ID↔OD
02400 CDR 10,0(15)↔PUSH P,[.+8]↔GO @.+1(16)↔ID↔ID↔ID↔ID↔ID↔OD
02500 CALL(AIVECT,[=320],[-=340])
02600 CAR 10,1(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔OD↔OD↔OD↔OD↔OD
02700 CDR 10,1(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔OD↔ID↔ID↔ID↔ID
02800 CALL(AIVECT,[=320],[-=360])
02900 CAR 10,2(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔OD↔OD↔OD↔OD↔OD
03000 CDR 10,2(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔ID↔ID↔OD↔OD↔OD
03100 CALL(AIVECT,[=320],[-=380])
03200 CAR 10,3(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔ID↔ID↔OD↔OD↔OD
03300 CDR 10,3(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔ID↔ID↔OD↔OD↔OD
03400 CALL(AIVECT,[=320],[-=400])
03500 NIP 10,4(15)↔JUMPL 10,[CALL(DTYO,["-"])↔MOVMS 10↔GO .+1]
03600 ↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔OD↔ID↔OD↔OD↔OD
03700 CDR 10,4(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔ID↔ID↔OD↔OD↔OD
03800 CALL(AIVECT,[=320],[-=420])
03900 CAR 10,5(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔OD↔OD↔OD↔OD↔OD
04000 CDR 10,5(15)↔PUSH P,[.+8]↔GO @.+1(16)↔OD↔OD↔OD↔OD↔OD↔OD
04100
04200 CAIN 16,2↔GO[CALL(DPYBRT,[5])↔CALL(DPYGON,15)↔GO .+1]
04300 CAIN 16,1↔GO[CALL(DPYBRT,[7])↔LAC 1,15↔JSR GETXY↔PUSHJ P,AI
04400 CCW 1,15↔JSR GETXY↔PUSHJ P,AV↔GO .+1]
04500 L2: CALL(DPYOUT,[1])↔POP0J
04600 BEND;13/12/72-----------------------------------------------------
04700 QBLK: 0
00100 ;DISPLAY HISTOGRAM.
00200 SUBR DPYHIS;------------------------------------------------------
00300 BEGIN DPYHIS;(PGON) - DISPLAY HISTOGRAM - BGB - 8 DEC 1972.
00400 X←←10 ↔ Y←←11 ↔ CNT←←14
00500
00600 CALL(HISTOG)
00700 CALL(DPYSET,DPYBUF)
00800 CALL(DPYBIG,[1])
00900
01000 ;SCALE THE IMAGE TO ITS LARGEST COLUMN.
01100 SETZ↔HRLZI 1,-77
01200 CAMGE 0,HISTO(1)↔LAC HISTO(1)↔AOBJN 1,.-2
01300 MOVE 1,[800.0]↔FSC 233↔FDV 1,0↔DAC 1,SY#
01400
01500 ;INITIALIZE HISTO LOOP.
01600 SETZ CNT,
01700 NIM X,=511↔NIM Y,-=404
01800 CALL(AIVECT,X,Y)↔MOVNS X
01900 CALL(AVECT,X,Y)
02000
02100 L1: SKIPN FTVSIX↔GO[TRNE CNT,3↔GO L2↔GO .+1]
02200 LAC Y,HISTO(CNT)↔FSC Y,233↔FMP Y,SY↔FIXX Y,
02300 SUBI Y,=400
02400 L2: CALL(AVECT,X,Y)
02500 TRNE CNT,3↔GO L3
02600 ;INTENSITY LEVEL NUMERAL.
02700 NIM 0,-=440↔SUBI X,10↔CALL(AIVECT,X,0)
02800 LAC CNT↔LSHC -3↔SKIPE↔IORI "0"↔IORI " "
02900 LSH 4↔LSHC 3
03000 IORI "0"↔ROT 0,-16↔IORI 1
03100 AOS 1,DPYPTR↔DAC(1)
03200 ;PEC CENT AT THIS LEVEL NUMERAL.
03300 NIM 0,-=465↔CALL(AIVECT,X,0)↔ADDI X,10
03400 LAC HISTO+0(CNT)↔ADD HISTO+1(CNT)
03500 ADD HISTO+2(CNT)↔ADD HISTO+3(CNT)
03600 IMULI =1000↔IDIVI =62208↔ADDI 5↔IDIVI =10
03700 JUMPE L4↔IDIVI =10
03800 ROT 1,-4
03900 SKIPE↔IORI "0"↔IORI " "
04000 LSH 3↔LSHC 4↔IORI "0"↔LSH 16↔IORI " %"
04100 LSH 8↔IORI 1↔AOS 1,DPYPTR↔DAC(1)
04200 L4: CALL(AIVECT,X,Y)
04300 ;ADVANCE.
04400 L3: ADDI X,20
04500 CALL(AVECT,X,Y)
04600 AOS CNT↔CAIE CNT,100↔GO L1
04700
04800 NIM -=400↔CALL(AVECT,X,0)
04900 CALL(DPYOUT,[0])↔CRLF↔POP0J
05000 BEND;16/12/72-----------------------------------------------------
00100 SUBR(DPYGON)PGON--------------------------------------------------
00200 BEGIN DPYGON; DISPLAY POLYGON - BGB - 4 DEC 1972.
00300
00400 ;FIRST EDGE/VERTEX ABSOLUTE INVISIBLE VECTOR.
00500 LAC 1,ARG1
00600 HEAD 1,1↔JUMPE 1,POP1J.
00700 L0: DAC 1,E0#↔DAC 1,V#
00800 JSR GETXY ↔ PUSHJ P,AI
00900
01000 ;FOLLOW AROUND THE POLYGON WITH ABS VISIBLE VECTORS.
01100 L1: LAC 1,V↔CDR 1,0(1)↔DAC 1,V
01200 JSR GETXY ↔ PUSHJ P,AV
01400 LAC 1,V↔EXO 2,1↔JUMPN 2,[
01500 ENDO 0,2↔CAME 0,V↔GO .+1
01600 LAC 1,2↔JSR GETXY↔CALL(AV)
01700 LAC 1,V↔JSR GETXY↔CALL(AV)↔GO .+1]
02100 LAC 1,V↔CAME 1,E0↔GO L1
02150 SKIPN FLGRAR↔POP1J
02175 LAC 1,ARG1↔ARC 1,1↔CAME 1,E0↔JUMPN 1,L0↔POP1J
02200
02300 BEND;4/12/72------------------------------------------------------
02400
02500 ;COLUMN INTO X-COORDINATE.
02600 GETXY: 0↔COL 0,1
02700 SUBI =144*=64
02800 FSC 225↔PUSH P,
02900
03000 ;ROW INTO Y-COORDINATE.
03100 ROW 2,1
03200 LACI =108*=64
03300 SUB 0,2
03400 FSC 225↔PUSH P,
03500 GO @GETXY
03600 ;13/12/72---------------------------------------------------------
03700 END SA